home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / winer / dbaccess.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-13  |  4.2 KB  |  172 lines
  1. '*********** DBACCESS.BAS - support module for access to .DBF files
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE FUNCTION Deleted% (Record$)
  7. DECLARE FUNCTION GetField$ (Record$, FldNum, FldArray() AS ANY)
  8. DECLARE FUNCTION GetFldNum% (FieldName$, FldArray() AS ANY)
  9. DECLARE FUNCTION PackDate$ ()
  10. DECLARE FUNCTION Padded$ (Fld$, FLen)
  11.  
  12. '$INCLUDE: 'DBF.BI'
  13. '$INCLUDE: 'DBACCESS.BI'
  14.  
  15. SUB CloseDBF (FileNum, TRecs&) STATIC
  16.  
  17.   Temp$ = PackDate$
  18.   PUT #FileNum, 2, Temp$
  19.   PUT #FileNum, 5, TRecs&
  20.   CLOSE #FileNum
  21.  
  22. END SUB
  23.  
  24. SUB CreateDBF (FileName$, FieldArray() AS FieldStruc) STATIC
  25.  
  26.   TFields = UBOUND(FieldArray)
  27.   HLen = TFields * 32 + 33
  28.   Header$ = STRING$(HLen + 1, 0)
  29.   Memo = 0
  30.  
  31.   FldBuf$ = STRING$(32, 0)
  32.   ZeroStuff$ = FldBuf$
  33.   FldOff = 33
  34.   RecLen = 1
  35.  
  36.   FOR X = 1 TO TFields
  37.     MID$(FldBuf$, 1) = FieldArray(X).FName
  38.     MID$(FldBuf$, 12) = FieldArray(X).FType
  39.     MID$(FldBuf$, 17) = CHR$(FieldArray(X).FLen)
  40.     MID$(FldBuf$, 18) = CHR$(FieldArray(X).Dec)
  41.     MID$(Header$, FldOff) = FldBuf$
  42.     LSET FldBuf$ = ZeroStuff$
  43.     FldOff = FldOff + 32
  44.     IF FieldArray(X).FType = "M" THEN Memo = -1
  45.     RecLen = RecLen + FieldArray(X).FLen
  46.   NEXT
  47.  
  48.   IF Memo THEN Version = 131 ELSE Version = 3
  49.   MID$(Header$, 1) = CHR$(Version)
  50.   Today$ = DATE$
  51.   Year = VAL(RIGHT$(Today$, 2))
  52.   Day = VAL(MID$(Today$, 4, 2))
  53.   Month = VAL(LEFT$(Today$, 2))
  54.  
  55.   MID$(Header$, 2) = PackDate$
  56.   MID$(Header$, 5) = MKL$(0)
  57.   MID$(Header$, 9) = MKI$(HLen)
  58.   MID$(Header$, 11, 2) = MKI$(RecLen)
  59.   MID$(Header$, FldOff) = CHR$(13)
  60.   MID$(Header$, FldOff + 1) = CHR$(26)
  61.  
  62.   OPEN FileName$ FOR BINARY AS #1
  63.   PUT #1, 1, Header$
  64.   CLOSE #1
  65.  
  66. END SUB
  67.  
  68. FUNCTION Deleted% (Record$) STATIC
  69.  
  70.   Deleted% = 0
  71.   IF LEFT$(Record$, 1) = "*" THEN Deleted% = -1
  72.  
  73. END FUNCTION
  74.  
  75. FUNCTION GetField$ (Record$, FldNum, FldArray() AS FieldStruc) STATIC
  76.  
  77.   GetField$ = MID$(Record$, FldArray(FldNum).FOff, FldArray(FldNum).FLen)
  78.  
  79. END FUNCTION
  80.  
  81. FUNCTION GetFldNum% (FieldName$, FldArray() AS FieldStruc) STATIC
  82.  
  83.   FOR X = 1 TO UBOUND(FldArray)
  84.     IF FldArray(X).FName = FieldName$ THEN
  85.       GetFldNum = X
  86.       EXIT FUNCTION
  87.     END IF
  88.   NEXT
  89.  
  90. END FUNCTION
  91.  
  92. SUB GetRecord (FileNum, RecNum&, Record$, Header AS DBFHeadStruc) STATIC
  93.  
  94.   RecOff& = ((RecNum& - 1) * Header.RecLen) + Header.FirstRec
  95.   GET FileNum, RecOff&, Record$
  96.  
  97. END SUB
  98.  
  99. SUB OpenDBF (FileNum, FileName$, Header AS DBFHeadStruc, FldArray() AS FieldStruc) STATIC
  100.  
  101.   OPEN FileName$ FOR BINARY AS FileNum
  102.   GET FileNum, 9, HLen
  103.   Header.FirstRec = HLen + 1
  104.   Buffer$ = SPACE$(HLen)
  105.  
  106.   GET FileNum, 1, Buffer$
  107.   Header.Version = ASC(Buffer$)
  108.   IF Header.Version = 131 THEN
  109.     Header.Version = 3
  110.     Header.Memo = -1
  111.   ELSE
  112.     Header.Memo = 0
  113.   END IF
  114.  
  115.   Header.Year = ASC(MID$(Buffer$, 2, 1))
  116.   Header.Month = ASC(MID$(Buffer$, 3, 1))
  117.   Header.Day = ASC(MID$(Buffer$, 4, 1))
  118.   Header.TRecs = CVL(MID$(Buffer$, 5, 4))
  119.   Header.RecLen = CVI(MID$(Buffer$, 11, 2))
  120.   Header.TFields = (HLen - 33) \ 32
  121.  
  122.   REDIM FldArray(1 TO Header.TFields) AS FieldStruc
  123.   OffSet = 2
  124.   BuffOff = 33
  125.   Zero$ = CHR$(0)
  126.  
  127.   FOR X = 1 TO Header.TFields
  128.     FTerm = INSTR(BuffOff, Buffer$, Zero$)
  129.     FldArray(X).FName = MID$(Buffer$, BuffOff, FTerm - BuffOff)
  130.     FldArray(X).FType = MID$(Buffer$, BuffOff + 11, 1)
  131.     FldArray(X).FOff = OffSet
  132.     FldArray(X).FLen = ASC(MID$(Buffer$, BuffOff + 16, 1))
  133.     FldArray(X).Dec = ASC(MID$(Buffer$, BuffOff + 17, 1))
  134.     OffSet = OffSet + FldArray(X).FLen
  135.     BuffOff = BuffOff + 32
  136.   NEXT
  137.  
  138. END SUB
  139.  
  140. FUNCTION PackDate$ STATIC
  141.  
  142.   Today$ = DATE$
  143.   Year = VAL(RIGHT$(Today$, 2))
  144.   Day = VAL(MID$(Today$, 4, 2))
  145.   Month = VAL(LEFT$(Today$, 2))
  146.  
  147.   PackDate$ = CHR$(Year) + CHR$(Month) + CHR$(Day)
  148.  
  149. END FUNCTION
  150.  
  151. FUNCTION Padded$ (Fld$, FLen) STATIC
  152.  
  153.   Temp$ = SPACE$(FLen)
  154.   LSET Temp$ = Fld$
  155.   Padded$ = Temp$
  156.  
  157. END FUNCTION
  158.  
  159. SUB SetField (Record$, FText$, FldNum, FldArray() AS FieldStruc) STATIC
  160.  
  161.   FText$ = Padded$(FText$, FldArray(FldNum).FLen)
  162.   MID$(Record$, FldArray(FldNum).FOff, FldArray(FldNum).FLen) = FText$
  163.  
  164. END SUB
  165.  
  166. SUB SetRecord (FileNum, RecNum&, Record$, Header AS DBFHeadStruc) STATIC
  167.  
  168.   RecOff& = ((RecNum& - 1) * Header.RecLen) + Header.FirstRec
  169.   PUT FileNum, RecOff&, Record$
  170.  
  171. END SUB
  172.